
; Player Class
; combines several graphics-objects, controllable, spawns hook/weapons


(load "optimization.scm")
(load "globals.scm")         ; for *num-player-weapons*
(load "vector.scm")          ; for set-x set-y
(load "physics-object.scm")
(load "graphics-object.scm")
(load "callback-controller.scm")
(load "hook.scm")
(load "bazooka.scm")
(load "big-bomb.scm")
(load "machine-gun.scm")





(define feet%
  (class physics-object%
    
    ; PUBLIC VARIABLES
    (init-field [owner #f])
    ; PRIVATE VARIABLES
    (define standing     #f)
    (define found-ground #f)
    (define destroy      #f)
    
    ; Standing?
    (define/public (standing?)
      standing)
    
    ; Destroy Feet
    (define/public (destroy-feet)
      (set! destroy #t))
    
    ; Collide
    (define/override (collide x y collision)
      (when (not (eq? owner collision))
        (set! found-ground #t)))
    
    ; Update
    (define/override (update)
      (set! standing found-ground)
      (set! found-ground #f)
      (not destroy))
    
    ; Constructor/Initialization
    (super-new [solid #f] [bounce #f] [affected-by-gravity #f])))







(define player%
  (class physics-object%
    
    ; PHYSICS-OBJECT%
    (inherit-field position
                   velocity
                   size)
    (inherit randomize-position)
    ; PUBLIC VARIABLES
    (init-field [lives  *player-start-lives*]
                [health *player-max-health*])
    ; PRIVATE VARIABLES
    ;   color
    (define red   0)
    (define green 0)
    (define blue  0)
    ;   owned objects
    (define callback-controller (new callback-controller%))
    (define graphics-player     (new graphics-object% [graphics-name "player"] [frame-time #i1/4]))
    (define graphics-weapon     (new graphics-object% [graphics-name "weapon"]))
    (define graphics-aim        (make-object bitmap% (string-append *graphics-folder* "aim" *resource-file-extension*)))
    (define hook  #f)
    (define feet (new feet% [owner this]))
    (define death #f)
    ;   state tracking
    (define change-pressed #f)
    (define shooting #f)
    (define walk  'none)
    (define aim 'none)
    ;   degrees
    (define degree-walk  #i0)
    (define degree-aim   #i0)
    (define degree-total #i0)
    ;   weapons
    (define weapons      (make-vector *num-player-weapons* #f))
    (define weapon-types (make-vector *num-player-weapons* #f))
    (define weapon-current 0)
    ;   aim
    (define aim-vector (vector #i1 #i0))
    
    ; CALLBACK-CONTROLLER%
    (delegate set-controller-keys callback-controller)
    (delegate get-controller-keys callback-controller)
    (delegate controller-input    callback-controller)
    
    ; GETTERS
    (define/public (get-lives) lives)
    (define/public (get-red)   red)
    (define/public (get-green) green)
    (define/public (get-blue)  blue)
    
    
    
    
    
    
    
    
    ; Initialize
    (define/public (initialize)
      (set! health *player-max-health*)
      (set! lives  *player-start-lives*)
      (set! weapon-current 0)
      (set! hook #f)
      (send *world* add-object feet)
      (set! velocity (vector #i0 #i0))
      (set! degree-walk 0)
      (set! degree-aim  0)
      (update-degrees))
    
    ; Update Degrees
    (define (update-degrees)
      (set! degree-total (if (= #i0 degree-walk) degree-aim (- degree-walk degree-aim)))
      (send graphics-player anim-degree degree-walk)
      (send graphics-weapon anim-degree degree-total)
      (set! aim-vector (vector (flcos (fl* degree-total *radians-per-degree*)) (- (flsin (fl* degree-total *radians-per-degree*))))))
    
    
    
    
    
    ; Set Color
    (define/public (set-color r g b)
      (set! red   r)
      (set! green g)
      (set! blue  b))
    
    ; Apply Color
    (define/public (apply-color)
      (set! graphics-player (new graphics-object% [graphics-name "player"] [own-copy #t] [frame-time #i1/4]))
      (send graphics-player anim-mutate-frames (lambda (bitmap) (bitmap-pixel-scale bitmap 255 red green blue))))
    
    
    
    
    
    ; Heal
    (define/public (heal damage)
      (set! health (+ health damage))
      (when (> health *player-max-health*)
        (set! health *player-max-health*)))
    
    ; Take Damage
    (define/public (take-damage damage)
      (set! health (- health damage))
      (when (<= health 0)
        (set! hook #f)
        (set! death (new sprite% [position position] [sprite-name "death"] [frame-time #i1/10]))
        (send *world* add-object death)
        (set! health *player-max-health*)
        (randomize-position)))
    
    
    
    ; Launch
    (define (launch-projectile projectile)
      (send projectile set-position (vector-op fl+ position (vector-scalar-op fl* aim-vector
                                                                              (fl+ (vector-abs (vector-scalar-op / size 2))
                                                                                   (vector-abs (vector-scalar-op / (send projectile get-size) 2))))))
      (send projectile set-velocity (vector-op + velocity (vector-scalar-op fl* aim-vector (send projectile get-weapon-speed))))
      (send projectile anim-degree degree-total)
      (send *world* add-object projectile))
    
    
    
    
    
    
    
    ; Draw
    (define/override (draw dc)
      ; update anims
      (unless (eq? walk 'none)
        (send graphics-player anim-advance))
      ; draw
      ;   worm
      (send graphics-player draw dc (get-x position) (get-y position))
      (send graphics-weapon draw dc (get-x position) (get-y position))
      ;   aim
      (send dc draw-bitmap graphics-aim (fl+ (get-x position) (fl* #i40 (get-x aim-vector))) (fl+ (get-y position) (fl* #i40 (get-y aim-vector))))
      ;   weapon name
      (when change-pressed
        (let* ([weapon (vector-ref weapons weapon-current)]
               [name   (if weapon (send weapon get-weapon-name) "<empty>")])
          (send dc set-text-foreground (send the-color-database find-color "White"))
          (send dc set-font (make-object font% 8 'modern 'normal 'bold))
          (send dc draw-text name (fl- (get-x position) (fl* (fixnum->flonum (string-length name)) #i7/2)) (fl- (get-y position) #i30))))
      ;   hook
      (when hook
        (send dc set-pen "brown" 1 'solid)
        (send dc draw-line (get-x position) (get-y position) (get-x (send hook get-position)) (get-y (send hook get-position))))
      ;   stats
      ;     setup
      (send dc set-font (make-object font% 8 'modern 'normal))
      (send dc set-text-foreground (send the-color-database find-color "Black"))
      (send dc set-brush (make-object color% red green blue) 'solid)
      ;     player color
      (send dc draw-rectangle 8 (+ 10 (* *player-stats-pos* 45)) 104 40)
      ;     lives
      (send dc draw-text (string-append "lives: " (number->string lives)) 13 (+ 15 (* *player-stats-pos* 45)))
      ;     red health
      (send dc set-brush (send the-color-database find-color "Red") 'solid)
      (send dc draw-rectangle 10 (+ 33 (* *player-stats-pos* 45)) 100 5)
      ;     green health
      (send dc set-brush (send the-color-database find-color "Green") 'solid)
      (send dc draw-rectangle 10 (+ 33 (* *player-stats-pos* 45)) (* 100 (/ health *player-max-health*)) 5)
      ;     weapon
      (when (vector-ref weapons weapon-current)
        (let ([status (send (vector-ref weapons weapon-current) get-clip)]
              [brush  (send the-color-database find-color "Cyan")])
          (when (fl= status #i0)
            (set! status (send (vector-ref weapons weapon-current) get-reload))
            (set! brush  (send the-color-database find-color "Blue")))
          (send dc set-brush brush 'solid)
          (send dc draw-rectangle 10 (+ 41 (* *player-stats-pos* 45)) (* 100 status) 5)))
      ;     advance pos
      (set! *player-stats-pos* (+ 1 *player-stats-pos*)))

    
    
    
    ; Update
    (define/override (update)
      ; Update aim
      (unless (eq? aim 'none)
        (cond ((and (eq? 'up   aim) (fl< degree-aim *player-aim-max*)) (set! degree-aim (fl+ degree-aim (fl* *player-aim-speed* *time-delta*))))
              ((and (eq? 'down aim) (fl> degree-aim *player-aim-min*)) (set! degree-aim (fl- degree-aim (fl* *player-aim-speed* *time-delta*)))))
        (set! degree-aim (clamp *player-aim-min* *player-aim-max* degree-aim))
        (update-degrees))
      ; apply walk acceleration
      (unless (eq? walk 'none)
        (set! velocity (vector-op fl+ velocity (vector-scalar-op fl*
                                                                 (vector ((if (eq? walk 'left) fl- fl+)
                                                                          (if (send feet standing?) *player-walk-acceleration* *player-fly-acceleration*))
                                                                         (if (send feet standing?) #i0 #i0))
                                                                 *time-delta*))))
      ; apply hook acceleration
      (when (and hook (send hook stuck?))
        (let ([hook-vector (vector-op fl- (send hook get-position) position)])
          (set! velocity (vector-op fl+ velocity (vector-scalar-op fl* hook-vector (fl/ (fl* *hook-acceleration* *time-delta*) (vector-abs hook-vector)))))))
      ; feet
      (send feet set-position (vector (get-x position) (fl+ (get-y position) (fl/ (fixnum->flonum (+ (get-y size) *player-feet-height*)) #i2))))
      ; weapon
      (let* ([weapon (vector-ref weapons weapon-current)])
        (when weapon
          (send weapon weapon-load)
          (when (and shooting (send weapon ready-to-fire?))
            (send (vector-ref weapons weapon-current) fire)
            (launch-projectile (new (vector-ref weapon-types weapon-current))))))
      ; handle death anim
      (when (and death (send death ended?))
        (set! death #f)
        (set! lives (sub1 lives)))
      ; when lives are out
      (when (= lives 0)
        (set! position (vector-scalar-op * size -1))
        (send feet destroy-feet)
        (set! feet #f)
        (set! *num-players-left* (sub1 *num-players-left*)))
      ; return
      (not (= lives 0)))
    
    

    

    
    
    
    
    ; Direction
    (define (direction pressed dir)
      (if change-pressed
          ; change
          (when pressed (set! weapon-current (rotate-in-range *num-player-weapons* ((if (eq? dir 'right) add1 sub1) weapon-current))))
          (if (not (or (eq? walk 'none) (eq? walk dir)))
              ; dig
              (when pressed 
                (send *world* add-object (new destruction%
                                              [position (vector-op + position (vector-scalar-op * aim-vector (fl/ (get-x size) #i2)))]
                                              [size (vector-scalar-op fxquotient (vector-scalar-op * size 3) 2)])))
              ; walk
              (if pressed
                  ; start
                  (begin
                    (set! walk dir)
                    (set! degree-walk (if (eq? dir 'right) #i0 #i180))
                    (update-degrees))
                  ;stop
                  (set! walk 'none)))))
    ; Left
    (define (left pressed)
      (direction pressed 'left))
    ; Right
    (define (right pressed)
      (direction pressed 'right))
    
    ; Aim
    (define (aim-up   pressed) (set! aim (if pressed 'up   'none)))
    (define (aim-down pressed) (set! aim (if pressed 'down 'none)))
    
    ; Shoot
    (define (shoot pressed)
      (if change-pressed
          ; hook
          (if pressed
              (begin
                (when hook (send hook release-hook))
                (set! hook (new hook%))
                (launch-projectile hook))
              (set! shooting #f))
          ; weapon
          (set! shooting pressed)))
    
    ; Jump
    (define (jump pressed)
      (when pressed
        (if hook
            ; hook
            (begin
              (send hook release-hook)
              (set! hook #f))
            ; not hook
            (when (send feet standing?)
              (set-y velocity (fl- (get-y velocity) *player-jump-speed*))))))
    
    ; Change
    (define (change pressed)
      (set! change-pressed pressed))
    
    
    
    ; Constructor/Initialization
    (super-new [size (make-size graphics-player)])
    ; initialize feet
    (send feet set-size (vector (get-x size) *player-feet-height*))
    ; fill weapon-types vector
    (vector-for-each (lambda (i e)
                       (vector-set! weapon-types i e))
                     (vector bazooka% big-bomb% machine-gun%))
    ; fill weapons vector
    (vector-for-each (lambda (i e)
                       (when e (vector-set! weapons i (new e))))
                     weapon-types)
    ; set controll callbacks
    (send callback-controller set-controller-callbacks (vector left right aim-up aim-down shoot jump change))))


